home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / public / SciAn / src / ScianArrays.c < prev    next >
C/C++ Source or Header  |  1994-08-01  |  42KB  |  2,036 lines
  1. /*ScianArrays.c
  2.   Eric Pepke
  3.   February 9, 1990
  4.   Array handling stuff in scian
  5. */
  6.  
  7. #include "Scian.h"
  8. #include "ScianTypes.h"
  9. #include "ScianWindows.h"
  10. #include "ScianObjWindows.h"
  11. #include "ScianDialogs.h"
  12. #include "ScianArrays.h"
  13. #include "ScianLists.h"
  14. #include "ScianErrors.h"
  15. #include "ScianIDs.h"
  16. #include "ScianDatasets.h"
  17. #include "ScianTimers.h"
  18. #include "ScianNetObjects.h"
  19. #include "ScianGarbageMan.h"
  20.  
  21. ObjPtr arrayClass, objectArrayClass, byteArrayClass, shortArrayClass, realArrayClass, pointerArrayClass;
  22.  
  23. #ifdef PROTO
  24. long SearchReal(ObjPtr array, real value)
  25. #else
  26. long SearchReal(array, value)
  27. ObjPtr array;
  28. real value;
  29. #endif
  30. /*Assuming array is a sorted, 1-dimensional real array, finds the index to the
  31.   lowest element which is larger than value, or the dims if the value is
  32.   higher than all.  Returns -1 if the array is bad.*/
  33. {
  34.     long top, bottom, mid;
  35.     real *elements;
  36.     if ((!IsRealArray(array)) || (RANK(array) != 1))
  37.     {
  38.     ReportError("SearchReal",
  39.         "This function requires a real array of rank 1");
  40.     return -1;
  41.     }
  42.  
  43.     bottom = 0;
  44.     top = DIMS(array)[0] - 1;
  45.     elements = ELEMENTS(array);
  46.     if (value >= elements[top])
  47.     {
  48.     return top + 1;
  49.     }
  50.  
  51.     while (top > bottom)
  52.     {
  53.     mid = (top + bottom) / 2;
  54.     if (value >= elements[mid])
  55.     {
  56.         bottom = mid + 1;
  57.     }
  58.     else
  59.     {
  60.         top = mid;
  61.     }
  62.     }
  63.  
  64.     return bottom;
  65. }
  66.  
  67. #ifdef PROTO
  68. long SearchShort(ObjPtr array, short value)
  69. #else
  70. long SearchShort(array, value)
  71. ObjPtr array;
  72. short value;
  73. #endif
  74. /*Assuming array is a sorted, 1-dimensional short array, finds the index to the
  75.   lowest element which is larger than value, or the dims if the value is
  76.   higher than all.  Returns -1 if the array is bad.*/
  77. {
  78.     long top, bottom, mid;
  79.     short *elements;
  80.     if ((!IsShortArray(array)) || (RANK(array) != 1))
  81.     {
  82.     ReportError("SearchShort",
  83.         "This function requires a short array of rank 1");
  84.     return -1;
  85.     }
  86.  
  87.     bottom = 0;
  88.     top = DIMS(array)[0] - 1;
  89.     elements = ELEMENTS(array);
  90.     if (value >= elements[top])
  91.     {
  92.     return top + 1;
  93.     }
  94.  
  95.     while (top > bottom)
  96.     {
  97.     mid = (top + bottom) / 2;
  98.     if (value >= elements[mid])
  99.     {
  100.         bottom = mid + 1;
  101.     }
  102.     else
  103.     {
  104.         top = mid;
  105.     }
  106.     }
  107.  
  108.     return bottom;
  109. }
  110.  
  111. #ifdef PROTO
  112. real SearchFuzzyReal(ObjPtr array, real value)
  113. #else
  114. real SearchFuzzyReal(array, value)
  115. ObjPtr array;
  116. real value;
  117. #endif
  118. /*Assuming array is a sorted, 1-dimensional real array, finds a fuzzy real index
  119.   into the array.*/
  120. {
  121.     long found;
  122.     real *elements;
  123.  
  124.     if ((!IsRealArray(array)) || (RANK(array) != 1))
  125.     {
  126.     ReportError("SearchFuzzyReal",
  127.         "This function requires a real array of rank 1");
  128.     return 0.0;
  129.     }
  130.  
  131.     found = SearchReal(array, value);
  132.     elements = ELEMENTS(array);
  133.  
  134.     if (DIMS(array)[0] == 1)
  135.     {
  136.     /*Degenerate case*/
  137.     return 0;
  138.     }
  139.  
  140.     if (found >= DIMS(array)[0])
  141.     {
  142.     /*This is bigger.  Extrapolate*/
  143.     return (value - elements[DIMS(array)[0] - 1]) / 
  144.         (elements[DIMS(array)[0] - 1] - elements[DIMS(array)[0] - 2])
  145.         + (real) (DIMS(array)[0] - 1);
  146.     }
  147.     else if (found <= 0)
  148.     {
  149.     /*This is smaller.  Extrapolate*/
  150.     return (value - elements[0]) / (elements[1] - elements[0]);
  151.     }
  152.     else
  153.     {
  154.     /*It's in between*/
  155.     return (value - elements[found - 1]) / (elements[found] - elements[found - 1])
  156.         + (real) (found - 1);
  157.     }
  158. }
  159.  
  160. #ifdef PROTO
  161. real FuzzyRealIndex(ObjPtr array, real index)
  162. #else
  163. real FuzzyRealIndex(array, index)
  164. ObjPtr array;
  165. real index;
  166. #endif
  167. /*Assuming array is a sorted, 1-dimensional real array, indexes a fuzzy real index
  168.   into the array.*/
  169. {
  170.     real *elements;
  171.     long indexI;
  172.  
  173.     if ((!IsRealArray(array)) || (RANK(array) != 1))
  174.     {
  175.     ReportError("FuzzyRealIndex",
  176.         "This function requires a real array of rank 1");
  177.     return -1.0;
  178.     }
  179.  
  180.     elements = ELEMENTS(array);
  181.  
  182.     /*Degenerate case*/
  183.     if (DIMS(array)[0] == 1)
  184.     {
  185.     return elements[0];
  186.     }
  187.  
  188.     indexI = index;
  189.     if (indexI < 0)
  190.     {
  191.     /*Extrapolate*/
  192.     return elements[0] +
  193.         index * (elements[1] - elements[0]);
  194.     }
  195.     else if (indexI >= DIMS(array)[0] - 1)
  196.     {
  197.     /*Extrapolate*/
  198.     return elements[DIMS(array)[0] - 1] +
  199.         (index - (DIMS(array)[0] - 1)) * 
  200.             (elements[DIMS(array)[0] - 1] - elements[DIMS(array)[0] - 2]);
  201.     }
  202.     else
  203.     {
  204.     /*Interpolate*/
  205.     return elements[indexI] +
  206.         (index - (real) indexI) * (elements[indexI + 1] - elements[indexI]);
  207.     }
  208. }
  209.  
  210. static int globalVar;
  211.  
  212. #ifdef PROTO
  213. int CompareStringVars(const void *a, const void *b)
  214. #else
  215. int CompareStringVars(a, b)
  216. void *a, *b;
  217. #endif
  218. /*Compares two object's globalVar strings for qsort*/
  219. {
  220.     ObjPtr s1, s2;
  221.     s1 = GetStringVar("CompareStringVars", *((ObjPtr *) a), NAME);
  222.     s2 = GetStringVar("CompareStringVars", *((ObjPtr *) b), NAME);
  223.     if (!s1 || !s2) return 0;
  224.     return strcmp2(GetString(s1), GetString(s2));
  225. }
  226.  
  227. #ifdef PROTO
  228. ObjPtr SortArrayByStringVar(ObjPtr array, NameTyp var)
  229. #else
  230. ObjPtr SortArrayByStringVar(array, var)
  231. ObjPtr array;
  232. NameTyp var;
  233. #endif
  234. /*Sorts a 1-dimensional object array by var, which must be a string.
  235.   Returns the sorted array or NULLOBJ*/
  236. {
  237.     ObjPtr retVal;
  238.     long *newDims;
  239.     ObjPtr *elements, *newElements;
  240.     long k;
  241.  
  242.     if (!IsObjArray(array) || RANK(array) != 1)
  243.     {
  244.     ReportError("SortArrayByStringVar",
  245.         "This function requires an object array of rank 1");
  246.     return NULLOBJ;
  247.     }
  248.  
  249.     /*Make the elements*/
  250.     newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]);
  251.     if (!newElements)
  252.     {
  253.     OMErr();
  254.     return NULLOBJ;
  255.     }
  256.  
  257.     /*Make the dimensions*/
  258.     newDims = (long *) Alloc(sizeof(long));
  259.     if (!newDims)
  260.     {
  261.     Free(newElements);
  262.     OMErr();
  263.     return NULLOBJ;
  264.     }
  265.  
  266.     /*Make the array*/
  267.     retVal = NewObject(objectArrayClass,
  268.                   sizeof(Array) - sizeof(Obj));
  269.     /*If can't, return NIL*/
  270.     if (!retVal)
  271.     {
  272.     Free(newElements);
  273.     Free(newDims);
  274.     OMErr();
  275.     return NULLOBJ;
  276.     }
  277.  
  278.     /*Make elements and dims*/
  279.     ELEMENTS(retVal) = newElements;
  280.     DIMS(retVal) = newDims;
  281.     newDims[0] = DIMS(array)[0];
  282.  
  283.     /*Fill in values for flags and dimensions*/
  284.     SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
  285.  
  286.     RANK(retVal) = 1;
  287.  
  288.     elements = ELEMENTS(array);
  289.     for (k = 0; k < DIMS(array)[0]; ++k)
  290.     {
  291.     newElements[k] = elements[k];
  292.     }
  293.     globalVar = var;
  294.     qsort(newElements,
  295.       DIMS(array)[0],
  296.       sizeof(ObjPtr),
  297.       CompareStringVars);
  298.     return retVal;
  299. }
  300.  
  301. #ifdef PROTO
  302. long SearchStringVar(ObjPtr array, NameTyp whichVar, char *value)
  303. #else
  304. long SearchStringVar(array, whichVar, value)
  305. ObjPtr array;
  306. NameTyp whichVar;
  307. char *value;
  308. #endif
  309. /*Assuming array is a sorted, 1-dimensional object array, finds the index to the
  310.   lowest element which has a string var whichVar larger than value, 
  311.   or the dims if the value is higher than all.  Returns -1 if the array is bad.*/
  312. {
  313.     long top, bottom, mid;
  314.     ObjPtr var;
  315.     ObjPtr *elements;
  316.  
  317.     if ((!IsObjArray(array)) || (RANK(array) != 1))
  318.     {
  319.     ReportError("SearchStringVar",
  320.         "This function requires an object array of rank 1");
  321.     return -1;
  322.     }
  323.  
  324.     bottom = 0;
  325.     top = DIMS(array)[0] - 1;
  326.     elements = ELEMENTS(array);
  327.  
  328.     MakeVar(elements[top], whichVar);
  329.     var = GetVar(elements[top], whichVar);
  330.     if (var && IsString(var))
  331.     {
  332.     if (strcmp2(value, GetString(var)) >= 0)
  333.     {
  334.         return top + 1;
  335.     }
  336.     }
  337.     else
  338.     {
  339.     return -1;
  340.     }
  341.  
  342.     while (top > bottom)
  343.     {
  344.     mid = (top + bottom) / 2;
  345.     MakeVar(elements[mid], whichVar);
  346.     var = GetVar(elements[mid], whichVar);
  347.     if (var && IsString(var))
  348.     {
  349.         if (strcmp2(value, GetString(var)) >= 0)
  350.         {
  351.         bottom = mid + 1;
  352.         }
  353.         else
  354.         {
  355.         top = mid;
  356.         }
  357.     }
  358.     else
  359.     {
  360.         return -1;
  361.     }
  362.     }
  363.  
  364.     return bottom;
  365. }
  366.  
  367. #ifdef PROTO
  368. long SearchIntVar(ObjPtr array, NameTyp whichVar, int value)
  369. #else
  370. long SearchIntVar(array, whichVar, value)
  371. ObjPtr array;
  372. NameTyp whichVar;
  373. int value;
  374. #endif
  375. /*Assuming array is a sorted, 1-dimensional object array, finds the index to the
  376.   lowest element which has an int var whichVar larger than value, 
  377.   or the dims if the value is higher than all.  Returns -1 if the array is bad.*/
  378. {
  379.     long top, bottom, mid;
  380.     ObjPtr var;
  381.     ObjPtr *elements;
  382.  
  383.     if ((!IsObjArray(array)) || (RANK(array) != 1))
  384.     {
  385.     ReportError("SearchIntVar",
  386.         "This function requires an object array of rank 1");
  387.     return -1;
  388.     }
  389.  
  390.     bottom = 0;
  391.     top = DIMS(array)[0] - 1;
  392.     elements = ELEMENTS(array);
  393.  
  394.     MakeVar(elements[top], whichVar);
  395.     var = GetVar(elements[top], whichVar);
  396.     if (var && IsInt(var))
  397.     {
  398.     if (value >= GetInt(var))
  399.     {
  400.         return top + 1;
  401.     }
  402.     }
  403.     else
  404.     {
  405.     return -1;
  406.     }
  407.  
  408.     while (top > bottom)
  409.     {
  410.     mid = (top + bottom) / 2;
  411.     MakeVar(elements[mid], whichVar);
  412.     var = GetVar(elements[mid], whichVar);
  413.     if (var && IsInt(var))
  414.     {
  415.         if (value >= GetInt(var))
  416.         {
  417.         bottom = mid + 1;
  418.         }
  419.         else
  420.         {
  421.         top = mid;
  422.         }
  423.     }
  424.     else
  425.     {
  426.         return -1;
  427.     }
  428.     }
  429.  
  430.     return bottom;
  431. }
  432.  
  433. #ifdef PROTO
  434. static int ComparePointers(const void *a, const void *b)
  435. #else
  436. static int ComparePointers(a, b)
  437. void *a, *b;
  438. #endif
  439. /*Compares two pointers*/
  440. {
  441.     return (*(ObjPtr *) a) - (*(ObjPtr *) b);
  442. }
  443.  
  444. #ifdef PROTO
  445. static int CR(const void *a, const void *b)
  446. #else
  447. static int CR(a, b)
  448. void *a, *b;
  449. #endif
  450. /*Compares two reals*/
  451. {
  452.     return (*(real *) a) - (*(real *) b);
  453. }
  454.  
  455. #ifdef PROTO
  456. ObjPtr Uniq(ObjPtr array)
  457. #else
  458. ObjPtr Uniq(array)
  459. ObjPtr array;
  460. #endif
  461. /*Returns array with only unique elements of array.  Array must be 1-dimensional.
  462.   Warning!  This will sort the array first*/
  463. {
  464.     long *newDims;
  465.     ObjPtr retVal;
  466.     int s, d;
  467.  
  468.     if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1)
  469.     {
  470.     ReportError("Uniq",
  471.         "This function requires an array of rank 1");
  472.     return NULLOBJ;
  473.     }
  474.  
  475.     /*Make the new dims*/
  476.     newDims = (long *) Alloc(sizeof(long));
  477.     if (!newDims)
  478.     {
  479.     OMErr();
  480.     return NULLOBJ;
  481.     }
  482.  
  483.     /*Make the array*/
  484.     retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj));
  485.  
  486.     /*If can't, return NIL*/
  487.     if (!retVal)
  488.     {
  489.     Free(newDims);
  490.     OMErr();
  491.     return NULLOBJ;
  492.     }
  493.  
  494.     /*Set dims*/
  495.     DIMS(retVal) = newDims;
  496.  
  497.     /*Fill in values for flags and dimensions*/
  498.     SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
  499.  
  500.     RANK(retVal) = 1;
  501.  
  502.     if (IsRealArray(array))
  503.     {
  504.     real *elements;
  505.     real *newElements;
  506.  
  507.     elements = ELEMENTS(array);
  508.  
  509.     /*Make the new elements*/
  510.     newElements = (real *) Alloc(sizeof(real) * DIMS(array)[0]);
  511.     if (!newElements)
  512.     {
  513.         OMErr();
  514.         return NULLOBJ;
  515.     }
  516.  
  517.     for (s = 0; s < DIMS(array)[0]; ++s)
  518.     {
  519.         newElements[s] = elements[s];
  520.     }
  521.  
  522.     qsort(newElements,
  523.       DIMS(array)[0],
  524.       sizeof(real),
  525.       CR);
  526.  
  527.     s = d = 0;
  528.     ++s;
  529.     while (s < DIMS(array)[0])
  530.     {
  531.         if (newElements[s] != newElements[d])
  532.         {
  533.         newElements[++d] = newElements[s];
  534.         }
  535.         ++s;
  536.     }
  537.     newElements = Realloc(newElements, sizeof(ObjPtr) * (d + 1));
  538.     ELEMENTS(retVal) = newElements;
  539.     }
  540.     else
  541.     {
  542.     ObjPtr *elements;
  543.     ObjPtr *newElements;
  544.  
  545.     elements = ELEMENTS(array);
  546.  
  547.     /*Make the new elements*/
  548.     newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]);
  549.     if (!newElements)
  550.     {
  551.         OMErr();
  552.         return NULLOBJ;
  553.     }
  554.  
  555.     for (s = 0; s < DIMS(array)[0]; ++s)
  556.     {
  557.         newElements[s] = elements[s];
  558.     }
  559.  
  560.     qsort(newElements,
  561.       DIMS(array)[0],
  562.       sizeof(real),
  563.       ComparePointers);
  564.  
  565.     s = d = 0;
  566.     ++s;
  567.     while (s < DIMS(array)[0])
  568.     {
  569.         if (newElements[s] != newElements[d])
  570.         {
  571.         newElements[++d] = newElements[s];
  572.         }
  573.         ++s;
  574.     }
  575.     newElements = Realloc(newElements, sizeof(ObjPtr) * (d + 1));
  576.     ELEMENTS(retVal) = newElements;
  577.     }
  578.  
  579.     DIMS(retVal)[0] = d + 1;
  580.  
  581.     return retVal;
  582. }
  583.  
  584. #ifdef PROTO
  585. ObjPtr SortArray(ObjPtr array)
  586. #else
  587. ObjPtr SortArray(array)
  588. ObjPtr array;
  589. #endif
  590. /*Returns array from array sorted by real value or object address.  
  591.   Array must be 1-dimensional.*/
  592. {
  593.     long *newDims;
  594.     ObjPtr retVal;
  595.     long k;
  596.  
  597.     if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1)
  598.     {
  599.     ReportError("SortArray",
  600.         "This function requires an array of rank 1");
  601.     return NULLOBJ;
  602.     }
  603.  
  604.     /*Make the new dims*/
  605.     newDims = (long *) Alloc(sizeof(long));
  606.     if (!newDims)
  607.     {
  608.     OMErr();
  609.     return NULLOBJ;
  610.     }
  611.  
  612.     /*Make the array*/
  613.     retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj));
  614.  
  615.     /*If can't, return NIL*/
  616.     if (!retVal)
  617.     {
  618.     Free(newDims);
  619.     OMErr();
  620.     return NULLOBJ;
  621.     }
  622.  
  623.     /*Set dims*/
  624.     DIMS(retVal) = newDims;
  625.  
  626.     /*Fill in values for flags and dimensions*/
  627.     SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
  628.  
  629.     RANK(retVal) = 1;
  630.  
  631.     if (IsRealArray(array))
  632.     {
  633.     real *elements;
  634.     real *newElements;
  635.  
  636.     elements = ELEMENTS(array);
  637.  
  638.     /*Make the new elements*/
  639.     newElements = (real *) Alloc(sizeof(real) * DIMS(array)[0]);
  640.     if (!newElements)
  641.     {
  642.         OMErr();
  643.         return NULLOBJ;
  644.     }
  645.  
  646.     for (k = 0; k < DIMS(array)[0]; ++k)
  647.     {
  648.         newElements[k] = elements[k];
  649.     }
  650.  
  651.     qsort(newElements,
  652.       DIMS(array)[0],
  653.       sizeof(real),
  654.       CR);
  655.  
  656.     ELEMENTS(retVal) = newElements;
  657.     }
  658.     else
  659.     {
  660.     ObjPtr *elements;
  661.     ObjPtr *newElements;
  662.  
  663.     elements = ELEMENTS(array);
  664.  
  665.     /*Make the new elements*/
  666.     newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]);
  667.     if (!newElements)
  668.     {
  669.         OMErr();
  670.         return NULLOBJ;
  671.     }
  672.  
  673.     for (k = 0; k < DIMS(array)[0]; ++k)
  674.     {
  675.         newElements[k] = elements[k];
  676.     }
  677.  
  678.     qsort(newElements,
  679.       DIMS(array)[0],
  680.       sizeof(real),
  681.       ComparePointers);
  682.  
  683.     ELEMENTS(retVal) = newElements;
  684.     }
  685.  
  686.     DIMS(retVal)[0] = DIMS(array)[0];
  687.  
  688.     return retVal;
  689. }
  690.  
  691. #ifdef PROTO
  692. ObjPtr RealArrayDeltas(ObjPtr array)
  693. #else
  694. ObjPtr RealArrayDeltas(array)
  695. ObjPtr array;
  696. #endif
  697. /*Takes a real array of rank one, dimension n.  If n is 1, returns an array
  698.   of dimension 1 with a 0 in it.  If n > 1, returns an array of dimension
  699.   n - 1 where each element is the difference between successive elements
  700.   of array*/
  701. {
  702.     ObjPtr retVal;
  703.     real *sElements, *dElements;
  704.     long k;
  705.  
  706.     if ((!IsRealArray(array)) || RANK(array) != 1)
  707.     {
  708.     ReportError("Uniq",
  709.         "This function requires a real array of rank 1");
  710.     return NULLOBJ;
  711.     }
  712.  
  713.     if (DIMS(array)[0] <= 1)
  714.     {
  715.     retVal = NewRealArray(1, 1L);
  716.     *((real *) ELEMENTS(retVal)) = 0.0;
  717.     return retVal;
  718.     }
  719.  
  720.     /*Make new array*/
  721.     retVal = NewRealArray(1, DIMS(array)[0] - 1);
  722.  
  723.     /*If can't, return NIL*/
  724.     if (!retVal)
  725.     {
  726.     return NULLOBJ;
  727.     }
  728.  
  729.     /*Fill in new array*/
  730.     sElements = ELEMENTS(array);
  731.     dElements = ELEMENTS(retVal);
  732.     for (k = 0; k < DIMS(retVal)[0]; ++k)
  733.     {
  734.     dElements[k] = sElements[k + 1] - sElements[k];
  735.     }
  736.  
  737.     return retVal;
  738. }
  739.  
  740. #ifdef PROTO
  741. ObjPtr InsertInArray(ObjPtr array, ObjPtr value, long index)
  742. #else
  743. ObjPtr InsertInArray(array, value, index)
  744. ObjPtr array;
  745. ObjPtr value;
  746. long index;
  747. #endif
  748. /*Inserts value into a new array like array at index*/
  749. {
  750.     long *newDims;
  751.     ObjPtr retVal;
  752.     int s;
  753.  
  754.     if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1)
  755.     {
  756.     ReportError("InsertInArray",
  757.         "This function requires an array of rank 1");
  758.     return NULLOBJ;
  759.     }
  760.  
  761.     if (IsRealArray(array) && !IsReal(value))
  762.     {
  763.     ReportError("InsertInArray",
  764.         "You can only insert reals into real arrays");
  765.     }
  766.  
  767.     /*Make the new dims*/
  768.     newDims = (long *) Alloc(sizeof(long));
  769.     if (!newDims)
  770.     {
  771.     OMErr();
  772.     return NULLOBJ;
  773.     }
  774.  
  775.     /*Make the array*/
  776.     retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj));
  777.  
  778.     /*If can't, return NIL*/
  779.     if (!retVal)
  780.     {
  781.     Free(newDims);
  782.     OMErr();
  783.     return NULLOBJ;
  784.     }
  785.  
  786.     /*Set dims*/
  787.     DIMS(retVal) = newDims;
  788.     DIMS(retVal)[0] = DIMS(array)[0] + 1;
  789.  
  790.     /*Fill in values for flags and dimensions*/
  791.     SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
  792.  
  793.     RANK(retVal) = 1;
  794.  
  795.     if (IsRealArray(array))
  796.     {
  797.     real *elements;
  798.     real *newElements;
  799.  
  800.     elements = ELEMENTS(array);
  801.  
  802.     /*Make the new elements*/
  803.     newElements = (real *) Alloc(sizeof(real) * (DIMS(array)[0] + 1));
  804.     if (!newElements)
  805.     {
  806.         OMErr();
  807.         return NULLOBJ;
  808.     }
  809.  
  810.     /*Copy the elements*/
  811.     for (s = 0; s < index; ++s)
  812.     {
  813.         newElements[s] = elements[s];
  814.     }
  815.     newElements[index] = GetReal(value);
  816.     for (s = index; s < DIMS(array)[0]; ++s)
  817.     {
  818.         newElements[s + 1] = elements[s];
  819.     }
  820.     ELEMENTS(retVal) = newElements;
  821.     }
  822.     else
  823.     {
  824.     ObjPtr *elements;
  825.     ObjPtr *newElements;
  826.  
  827.     elements = ELEMENTS(array);
  828.  
  829.     /*Make the new elements*/
  830.     newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * (DIMS(array)[0] + 1));
  831.     if (!newElements)
  832.     {
  833.         OMErr();
  834.         return NULLOBJ;
  835.     }
  836.  
  837.     /*Copy the elements*/
  838.     for (s = 0; s < index; ++s)
  839.     {
  840.         newElements[s] = elements[s];
  841.     }
  842.     newElements[index] = value;
  843.     for (s = index; s < DIMS(array)[0]; ++s)
  844.     {
  845.         newElements[s + 1] = elements[s];
  846.     }
  847.     ELEMENTS(retVal) = newElements;
  848.     }
  849.  
  850.     return retVal;
  851. }
  852.  
  853. #ifdef PROTO
  854. ObjPtr InterpArray(ObjPtr interp1, ObjPtr interp2, real weight)
  855. #else
  856. ObjPtr InterpArray(interp1, interp2, weight)
  857. ObjPtr interp1, interp2;
  858. real weight;
  859. #endif
  860. /*Makes a new array that linearly interpolates between interp1 and interp2.
  861.   Weight is the amount, between 0.0 and 1.0, to favor interp2 over interp1.*/
  862. {
  863.     register long nels;            /*Number of elements in array*/
  864.     register int k;            /*Random counter*/    
  865.     long *dimPtr1, *dimPtr2, *dimPtr3;    /*Pointer to dimensions and then some*/
  866.     register real *interpPtr1, *interpPtr2;
  867.     register real *destPtr;
  868.     APtr retVal;
  869.     real *elements;            /*Pointer to the elements*/
  870.     long *dims;                /*Pointer to dims*/
  871.  
  872.     if ((!IsRealArray(interp1)) || (!IsRealArray(interp2)))
  873.     {
  874.     ReportError("InterpArray","Can only interpolate between real arrays");
  875.      return NULLOBJ;
  876.     }
  877.  
  878.     if (RANK(interp1) != RANK(interp2))
  879.     {
  880.     ReportError("InterpArray","Rank mismatch");
  881.     return NULLOBJ;
  882.     }
  883.  
  884.     nels = 1;
  885.     dimPtr1 = DIMS(interp1);
  886.     dimPtr2 = DIMS(interp2);
  887.  
  888.     for (k = 0; k < RANK(interp1); ++k)
  889.     {
  890.     if (*dimPtr1 != *dimPtr2)
  891.     {
  892.         ReportError("InterpArray","Dimension mismatch\n");
  893.         return NULLOBJ;
  894.     }
  895.     nels *= *dimPtr1;
  896.     ++dimPtr1;
  897.     ++dimPtr2;
  898.     } 
  899.  
  900.     /*Try to allocate the elements*/
  901.     elements = (real *) Alloc(nels * sizeof(real));
  902.  
  903.     /*If can't, return NIL*/
  904.     if (!elements)
  905.     {
  906.     OMErr();
  907.     return NULLOBJ;
  908.     }
  909.  
  910.     /*Try to allocate the dims*/
  911.     dims = (long *) Alloc(RANK(interp1) * sizeof(long));
  912.     if (!dims)
  913.     {
  914.     Free(elements);
  915.     OMErr();
  916.     return NULLOBJ;
  917.     }
  918.     
  919.     /*Make the array*/
  920.     retVal = (APtr) NewObject(realArrayClass,
  921.                   sizeof(Array) - sizeof(Obj));
  922.  
  923.     /*If can't, return NIL*/
  924.     if (!retVal)
  925.     {
  926.     OMErr();
  927.     Free(elements);
  928.     Free(dims);
  929.     return (ObjPtr) retVal;
  930.     }
  931.  
  932.     /*Make elements and dims*/
  933.     ELEMENTS(retVal) = elements;
  934.     DIMS(retVal) = dims;
  935.  
  936.     /*Fill in values for flags and dimensions*/
  937.     SETOBJTYPE(retVal -> thing . flags, REALARRAY);
  938.  
  939.     retVal -> rank = RANK(interp1);
  940.  
  941.     dimPtr1 = DIMS(interp1);
  942.     dimPtr2 = DIMS(interp2);
  943.     dimPtr3 = DIMS(retVal);
  944.  
  945.     for (k = 0; k < RANK(interp1); ++k)
  946.     {
  947.     DIMS(retVal)[k] = DIMS(interp1)[k];
  948.     ++dimPtr1;
  949.     ++dimPtr2;
  950.     ++dimPtr3;
  951.     } 
  952.  
  953.     interpPtr1 = ELEMENTS(interp1);
  954.     interpPtr2 = ELEMENTS(interp2);
  955.     destPtr = ELEMENTS(retVal);
  956.  
  957.     while (nels)
  958.     {
  959.     *destPtr = *interpPtr2 * weight + *interpPtr1 * (1.0 - weight);
  960.     if (*interpPtr1 == missingData || *interpPtr2 == missingData)
  961.     {
  962.         *destPtr = missingData;
  963.     }
  964.     ++destPtr;
  965.     ++interpPtr1;
  966.     ++interpPtr2;
  967.     --nels;
  968.     }
  969.     return (ObjPtr) retVal;
  970. }
  971.  
  972. #ifdef PROTO
  973. ObjPtr MergeRealArrays(ObjPtr merge1, ObjPtr merge2)
  974. #else
  975. ObjPtr MergeRealArrays(merge1, merge2)
  976. ObjPtr merge1, merge2;
  977. #endif
  978. /*Makes a new real array that merges values from merge1 and merge2.  Assumes
  979.   that merge1 and merge2 are already sorted*/
  980. {
  981.     register long nels1, nels2;        /*Number of elements in array*/
  982.     register int k;            /*Random counter*/  
  983.     register long s1, s2, d;        /*Indices for copy*/ 
  984.     register real *mergePtr1, *mergePtr2;
  985.     register real *destPtr;
  986.     APtr retVal;
  987.     real *elements;            /*Pointer to the elements*/
  988.     long *dims;                /*Pointer to dims*/
  989.  
  990.     if ((!IsRealArray(merge2)) || (!IsRealArray(merge1)))
  991.     {
  992.     ReportError("MergeRealArrays", "Can only merge real arrays");
  993.      return NULLOBJ;
  994.     }
  995.  
  996.     if (RANK(merge1) != 1 || RANK(merge2) != 1)
  997.     {
  998.     ReportError("MergeRealArrays", "Can only merge arrays of rank 1");
  999.     return NULLOBJ;
  1000.     }
  1001.  
  1002.     nels1 = DIMS(merge1)[0];
  1003.     nels2 = DIMS(merge2)[0];
  1004.  
  1005.     /*Try to allocate the elements*/
  1006.     elements = (real *) Alloc((nels1 + nels2) * sizeof(real));
  1007.  
  1008.     /*If can't, return NIL*/
  1009.     if (!elements)
  1010.     {
  1011.     OMErr();
  1012.     return NULLOBJ;
  1013.     }
  1014.  
  1015.     /*Try to allocate the dims*/
  1016.     dims = (long *) Alloc(sizeof(long));
  1017.     if (!dims)
  1018.     {
  1019.     Free(elements);
  1020.     OMErr();
  1021.     return NULLOBJ;
  1022.     }
  1023.     dims[0] = nels1 + nels2;
  1024.     
  1025.     /*Make the array*/
  1026.     retVal = (APtr) NewObject(realArrayClass, sizeof(Array) - sizeof(Obj));
  1027.  
  1028.     /*If can't, return NIL*/
  1029.     if (!retVal)
  1030.     {
  1031.     OMErr();
  1032.     Free(elements);
  1033.     Free(dims);
  1034.     return (ObjPtr) retVal;
  1035.     }
  1036.  
  1037.     /*Make elements and dims*/
  1038.     ELEMENTS(retVal) = elements;
  1039.     DIMS(retVal) = dims;
  1040.  
  1041.     /*Fill in values for flags and dimensions*/
  1042.     SETOBJTYPE(retVal -> thing . flags, REALARRAY);
  1043.  
  1044.     retVal -> rank = 1;
  1045.  
  1046.     mergePtr1 = ELEMENTS(merge1);
  1047.     mergePtr2 = ELEMENTS(merge2);
  1048.     destPtr = ELEMENTS(retVal);
  1049.     s1 = 0; s2 = 0; d = 0;
  1050.     while (s1 < nels1 || s2 < nels2)
  1051.     {
  1052.     if (s2 >= nels2)
  1053.     {
  1054.         destPtr[d] = mergePtr1[s1];
  1055.         ++s1;
  1056.         ++d;
  1057.     }
  1058.     else if (s1 >= nels1)
  1059.     {
  1060.         destPtr[d] = mergePtr2[s2];
  1061.         ++s2;
  1062.         ++d;
  1063.     }
  1064.     else if (mergePtr1[s1] < mergePtr2[s2])
  1065.     {
  1066.         destPtr[d] = mergePtr1[s1];
  1067.         ++s1;
  1068.         ++d;
  1069.     }
  1070.     else
  1071.     {
  1072.         destPtr[d] = mergePtr2[s2];
  1073.         ++s2;
  1074.         ++d;
  1075.     }
  1076.     }
  1077.  
  1078.     return (ObjPtr) retVal;
  1079. }
  1080.  
  1081. void CArray2Array(array, pointer)
  1082. ObjPtr array;
  1083. real *pointer;
  1084. /*Fills array with the data at pointer.  It better be right!*/
  1085. {
  1086.     long nels;                /*Number of elements in array*/
  1087.     int k;                /*Random counter*/    
  1088.     long *dimPtr;            /*Pointer to dimensions and then some*/
  1089.     real *destPtr;            /*Pointer to destination within array*/
  1090.  
  1091.     nels = 1;
  1092.     dimPtr = DIMS(array);
  1093.     for (k = 0; k < RANK(array); ++k)
  1094.     {
  1095.     nels *= *dimPtr;
  1096.     ++dimPtr;
  1097.     } 
  1098.     destPtr = ELEMENTS(array);
  1099.     while (nels)
  1100.     {
  1101.     *destPtr = *pointer;
  1102.     ++destPtr;
  1103.     ++pointer;
  1104.     --nels;
  1105.     }
  1106. }
  1107.  
  1108. #ifdef PROTO
  1109. void MinMax(real *min, real *max, real *elements, long nels)
  1110. #else
  1111. void MinMax(min, max, elements, nels)
  1112. real *min;
  1113. real *max;
  1114. real *elements;
  1115. long nels;
  1116. #endif
  1117. /*Returns the min and max of nels reals at elements*/
  1118. {
  1119.     Bool firstTime = true;
  1120.     while (nels)
  1121.     {
  1122.     if (*elements != missingData)
  1123.     {
  1124.         if (firstTime)
  1125.         {
  1126.         firstTime = false;
  1127.         *min = *max = *elements;
  1128.         }
  1129.         else
  1130.         {
  1131.  
  1132.         if (*elements > *max) *max = *elements;
  1133.         if (*elements < *min) *min = *elements;
  1134.         }
  1135.     }
  1136.     ++elements;
  1137.     --nels;
  1138.     }
  1139. }
  1140.  
  1141. void Array2CArray(pointer, array)
  1142. ObjPtr array;
  1143. real *pointer;
  1144. /*Fills data at pointer with array.  It better be right!*/
  1145. {
  1146.     int nels;                /*Number of elements in array*/
  1147.     int k;                /*Random counter*/    
  1148.     long *dimPtr;            /*Pointer to dimensions and then some*/
  1149.     real *srcPtr;            /*Pointer to source within array*/
  1150.  
  1151.     nels = 1;
  1152.     dimPtr = DIMS(array);
  1153.     for (k = 0; k < ((APtr) array) -> rank; ++k)
  1154.     {
  1155.     nels *= *dimPtr;
  1156.     ++dimPtr;
  1157.     } 
  1158.     srcPtr = ELEMENTS(array);
  1159.     while (nels)
  1160.     {
  1161.     *pointer = *srcPtr;
  1162.     ++srcPtr;
  1163.     ++pointer;
  1164.     --nels;
  1165.     }
  1166. }
  1167.  
  1168. #ifdef PROTO
  1169. ObjPtr NewRealArray(int rank, ...)
  1170. #else
  1171. ObjPtr NewRealArray(rank)
  1172. int rank;
  1173. #endif
  1174. /*Makes a real array with rank rank and long dimensions starting after.  For 
  1175.   example, to make a 20 by 25 by 30 array, use NewRealArray(3, 20, 25, 30).
  1176.   An array of rank 0 has exactly one element.  Arrays of negative rank will
  1177.   return NIL, as will arrays too big to create in memory.  Sets every element
  1178.   of the array to zero*/
  1179. {
  1180.     long numEls;        /*Number of elements in array*/
  1181.     register int k;        /*Counter for random purposes*/
  1182.     long *dimPtr;        /*Pointer to the next dimension*/
  1183.     APtr retVal;        /*Value to return*/
  1184.     real *runner;        /*Runner for setting stuff to 0.0*/
  1185.     real *elements;        /*The elements of the array*/
  1186.     long *dims;            /*The dimensions of the array*/
  1187.  
  1188.     /*Check for valid rank*/
  1189.     if (rank < 0)
  1190.     {
  1191.     return (ObjPtr) NIL;
  1192.     }
  1193.  
  1194.     /*Calculate the number of elements*/
  1195.     dimPtr = (long *) (&rank + 1);
  1196.     numEls = 1;
  1197.     for (k = 0; k < rank; ++k)
  1198.     {
  1199.     numEls *= *dimPtr;
  1200.     ++dimPtr;
  1201.     }
  1202.  
  1203.     /*Try to allocate the elements*/
  1204.     elements = (real *) Alloc(numEls * sizeof(real));
  1205.     if (!elements)
  1206.     {
  1207.     OMErr();
  1208.     return NULLOBJ;
  1209.     }
  1210.     
  1211.     /*Try to allocate the dims*/
  1212.     dims = 0;
  1213.     if (rank)
  1214.     {
  1215.     dims = (long *) Alloc(rank * sizeof(long));
  1216.     if (!dims)
  1217.     {
  1218.         Free(elements);
  1219.         OMErr();
  1220.         return NULLOBJ;
  1221.     }
  1222.     }
  1223.     
  1224.     /*Try to allocate the array*/
  1225.     retVal = (APtr) NewObject(realArrayClass,
  1226.                   sizeof(Array) - sizeof(Obj));
  1227.     /*If can't, return NIL*/
  1228.     if (!retVal)
  1229.     {
  1230.     OMErr();
  1231.     Free(elements);
  1232.     SAFEFREE(dims);
  1233.     return NULLOBJ;
  1234.     }
  1235.  
  1236.     /*Put in the elements and dims*/
  1237.     ELEMENTS(retVal) = elements;
  1238.     DIMS(retVal) = dims;
  1239.  
  1240.     /*Fill in values for flags and dimensions*/
  1241.     SETOBJTYPE(retVal -> thing . flags, REALARRAY);
  1242.  
  1243.     RANK(retVal) = rank;
  1244.     dimPtr = (long *) (&rank + 1);
  1245.     for (k = 0; k < rank; ++k)
  1246.     {
  1247.     DIMS(retVal)[k] = *dimPtr;
  1248.         ++dimPtr;
  1249.     }
  1250.  
  1251.     /*Zero the array*/
  1252.     runner = ArrayMeat((ObjPtr) retVal);
  1253.     while (numEls)
  1254.     {
  1255.     *runner = 0.0;
  1256.     ++runner;
  1257.     --numEls;
  1258.     }
  1259.  
  1260.     return (ObjPtr) retVal;    
  1261. }
  1262.  
  1263. #ifdef PROTO
  1264. ObjPtr NewArray(int arrayType, int rank, long *dimensions)
  1265. #else
  1266. ObjPtr NewArray(arrayType, rank, dimensions)
  1267. int arrayType;
  1268. int rank;
  1269. long *dimensions;
  1270. #endif
  1271. /*Makes an array of arrayType with rank rank and dimensions in an array of longs
  1272.   pointed to by dimensions.  Arrays of negative rank will return NIL, as will 
  1273.   arrays too big to create in memory.  Sets every element of the array to zero
  1274.   or NIL or whatever*/
  1275. {
  1276.     long numEls;        /*Number of elements in array*/
  1277.     register int k;        /*Counter for random purposes*/
  1278.     APtr retVal;        /*Value to return*/
  1279.     long *dimPtr;        /*Running pointer to dimensions*/
  1280.     long *dims;            /*Pointer to dimensions*/
  1281.     ObjPtr superClass;
  1282.  
  1283.     /*Check for valid rank*/
  1284.     if (rank < 0)
  1285.     {
  1286.     return (ObjPtr) NIL;
  1287.     }
  1288.  
  1289.     /*Calculate the number of elements*/
  1290.     numEls = 1;
  1291.     dimPtr = dimensions;
  1292.     for (k = 0; k < rank; ++k)
  1293.     {
  1294.     numEls *= *dimPtr;
  1295.     ++dimPtr;
  1296.     }
  1297.  
  1298.     /*Try to allocate the array*/
  1299.     switch(arrayType)
  1300.     {
  1301.     case AT_REAL:
  1302.         superClass = realArrayClass;
  1303.         break;
  1304.     case AT_OBJECT:
  1305.         superClass = objectArrayClass;
  1306.         break;
  1307.     case AT_BYTE:
  1308.         superClass = byteArrayClass;
  1309.         break;
  1310.     case AT_POINTER:
  1311.         superClass = pointerArrayClass;
  1312.         break;
  1313.     case AT_SHORT:
  1314.         superClass = shortArrayClass;
  1315.         break;
  1316.     default:
  1317.         ReportError("NewArray", "Bad array type");
  1318.         return ObjFalse;
  1319.     }
  1320.     retVal = (APtr) NewObject(superClass, sizeof(Array) - sizeof(Obj));
  1321.  
  1322.     /*If can't, return NIL*/
  1323.     if (!retVal)
  1324.     {
  1325.     OMErr();
  1326.     return (ObjPtr) retVal;
  1327.     }
  1328.  
  1329.     ELEMENTS(retVal) = 0;
  1330.     DIMS(retVal) = 0;
  1331.  
  1332.     /*Try to allocate the elements*/
  1333.     switch(arrayType)
  1334.     {
  1335.     case AT_REAL:
  1336.         {
  1337.         real *elements;
  1338.         real *runner;
  1339.         elements = (void *) Alloc(numEls * sizeof(real));
  1340.  
  1341.         /*If can't, return NIL*/
  1342.         if (!elements)
  1343.         {
  1344.             OMErr();
  1345.             return NULLOBJ;
  1346.         }
  1347.  
  1348.         /*Put in the elements*/
  1349.         ELEMENTS(retVal) = elements;
  1350.  
  1351.         /*Fill in values for flags*/
  1352.         SETOBJTYPE(retVal -> thing . flags, REALARRAY);
  1353.  
  1354.         /*Zero the array*/
  1355.         runner = elements;
  1356.         while (numEls)
  1357.         {
  1358.             *runner = 0.0;
  1359.             ++runner;
  1360.             --numEls;
  1361.         }
  1362.         }
  1363.         break;
  1364.     case AT_BYTE:
  1365.         {
  1366.         unsigned char *elements;
  1367.         unsigned char *runner;
  1368.         elements = (void *) Alloc(numEls * sizeof(unsigned char));
  1369.  
  1370.         /*If can't, return NIL*/
  1371.         if (!elements)
  1372.         {
  1373.             OMErr();
  1374.             return NULLOBJ;
  1375.         }
  1376.  
  1377.         /*Put in the elements*/
  1378.         ELEMENTS(retVal) = elements;
  1379.  
  1380.         /*Fill in values for flags*/
  1381.         SETOBJTYPE(retVal -> thing . flags, OT_BYTEARRAY);
  1382.  
  1383.         /*Zero the array*/
  1384.         runner = elements;
  1385.         while (numEls)
  1386.         {
  1387.             *runner = 0;
  1388.             ++runner;
  1389.             --numEls;
  1390.         }
  1391.         }
  1392.         break;
  1393.     case AT_SHORT:
  1394.         {
  1395.         short *elements;
  1396.         short *runner;
  1397.         elements = (void *) Alloc(numEls * sizeof(short));
  1398.  
  1399.         /*If can't, return NIL*/
  1400.         if (!elements)
  1401.         {
  1402.             OMErr();
  1403.             return NULLOBJ;
  1404.         }
  1405.  
  1406.         /*Put in the elements*/
  1407.         ELEMENTS(retVal) = elements;
  1408.  
  1409.         /*Fill in values for flags*/
  1410.         SETOBJTYPE(retVal -> thing . flags, OT_SHORTARRAY);
  1411.  
  1412.         /*Zero the array*/
  1413.         runner = elements;
  1414.         while (numEls)
  1415.         {
  1416.             *runner = 0;
  1417.             ++runner;
  1418.             --numEls;
  1419.         }
  1420.         }
  1421.         break;
  1422.     case AT_OBJECT:
  1423.         {
  1424.         ObjPtr *elements;
  1425.         ObjPtr *runner;
  1426.         elements = (void *) Alloc(numEls * sizeof(ObjPtr));
  1427.  
  1428.         /*If can't, return NIL*/
  1429.         if (!elements)
  1430.         {
  1431.             OMErr();
  1432.             return NULLOBJ;
  1433.         }
  1434.  
  1435.  
  1436.         /*Put in the elements*/
  1437.         ELEMENTS(retVal) = elements;
  1438.  
  1439.         /*Fill in values for flags*/
  1440.         SETOBJTYPE(retVal -> thing . flags, OBJECTARRAY);
  1441.  
  1442.         /*Zero the array*/
  1443.         runner = elements;
  1444.         while (numEls)
  1445.         {
  1446.             *runner = NULLOBJ;
  1447.             ++runner;
  1448.             --numEls;
  1449.         }
  1450.         }
  1451.         break;
  1452.     case AT_POINTER:
  1453.         {
  1454.         void **elements;
  1455.         void **runner;
  1456.         elements = (void *) Alloc(numEls * sizeof(ObjPtr));
  1457.  
  1458.         /*If can't, return NIL*/
  1459.         if (!elements)
  1460.         {
  1461.             OMErr();
  1462.             return NULLOBJ;
  1463.         }
  1464.  
  1465.         /*Put in the elements*/
  1466.         ELEMENTS(retVal) = elements;
  1467.  
  1468.         /*Fill in values for flags*/
  1469.         SETOBJTYPE(retVal -> thing . flags, OT_POINTERARRAY);
  1470.  
  1471.         /*Zero the array*/
  1472.         runner = elements;
  1473.         while (numEls)
  1474.         {
  1475.             *runner = NULL;
  1476.             ++runner;
  1477.             --numEls;
  1478.         }
  1479.         }
  1480.         break;
  1481.     default:
  1482.         ReportError("NewArray", "Bad array type");
  1483.         return NULLOBJ;
  1484.     }
  1485.  
  1486.     /*Try to allocate the dims*/
  1487.     if (rank)
  1488.     {
  1489.     dims = (long *) Alloc(rank * sizeof(long));
  1490.     if (!dims)
  1491.     {
  1492.         OMErr();
  1493.         return NULLOBJ;
  1494.     }
  1495.     }
  1496.     else
  1497.     {
  1498.     dims = 0;
  1499.     }
  1500.     DIMS(retVal) = dims;
  1501.     
  1502.     /*Fill in rank and dimensions*/
  1503.     retVal -> rank = rank;
  1504.     dimPtr = dimensions;
  1505.     for (k = 0; k < rank; ++k)
  1506.     {
  1507.     retVal -> dims[k] = *dimPtr;
  1508.         ++dimPtr;
  1509.     }
  1510.  
  1511.     return (ObjPtr) retVal;    
  1512. }
  1513.  
  1514. #ifdef PROTO
  1515. ObjPtr ListToArray(ObjPtr list)
  1516. #else
  1517. ObjPtr ListToArray(list)
  1518. ObjPtr list;
  1519. #endif
  1520. /*Converts a list to a 1-dimensional object array*/
  1521. {
  1522.     ObjPtr retVal;
  1523.     long size;
  1524.     ThingListPtr runner;
  1525.     ObjPtr *elements;
  1526.     long k;
  1527.  
  1528.     size = ListCount(list);
  1529.     retVal = NewArray(AT_OBJECT, 1, &size);
  1530.  
  1531.     elements = ELEMENTS(retVal);
  1532.     runner = LISTOF(list);
  1533.     k = 0;
  1534.     while (runner)
  1535.     {
  1536.     elements[k] = runner -> thing;
  1537.     ++k;
  1538.     runner = runner -> next;
  1539.     }
  1540.     return retVal;
  1541. }
  1542.  
  1543. static ObjPtr MarkObjectArray(array)
  1544. ObjPtr array;
  1545. /*Marks an object array*/
  1546. {
  1547.     long nels;
  1548.     long *dimPtr;
  1549.     long k;
  1550.     ObjPtr *meat;
  1551.     if (!IsObjArray(array))
  1552.     {
  1553.     /*Needed to avoid marking class*/
  1554.     return ObjFalse;
  1555.     }
  1556.  
  1557.     nels = 1;
  1558.     dimPtr = DIMS(array);
  1559.  
  1560.     for (k = 0; k < RANK(array); ++k)
  1561.     {
  1562.     nels *= *dimPtr;
  1563.     ++dimPtr;
  1564.     }
  1565.     meat = (ObjPtr *) ELEMENTS(array);
  1566.     while (nels)
  1567.     {
  1568.     if (*meat)
  1569.     {
  1570.         MarkObject(*meat);
  1571.     }
  1572.     ++meat;
  1573.     --nels;
  1574.     }
  1575.     return ObjTrue;
  1576. }
  1577.  
  1578. static ObjPtr CleanupArray(array)
  1579. ObjPtr array;
  1580. /*Cleans up an array by getting rid of its elements*/
  1581. {
  1582.     if (ELEMENTS(array))
  1583.     {
  1584.     Free(ELEMENTS(array));
  1585.     ELEMENTS(array) = 0;
  1586.     }
  1587.     if (DIMS(array))
  1588.     {
  1589.     Free(DIMS(array));
  1590.     DIMS(array) = 0;
  1591.     }
  1592.     return ObjTrue;
  1593. }
  1594.  
  1595. static ObjPtr RegisterRealArray(field, whichField)
  1596. ObjPtr field;
  1597. int whichField;
  1598. /*Registers an array field in field slot whichField*/
  1599. {
  1600.     Component *component = 0;
  1601.  
  1602.     component = (Component *) Alloc(sizeof(Component));
  1603.     if (!component)
  1604.     {
  1605.     OMErr();
  1606.     return ObjFalse;
  1607.     }
  1608.  
  1609.     component -> flags = 0;
  1610.     component -> indices = 0;
  1611.     component -> dimensions = 0;
  1612.     component -> steps = 0;
  1613.  
  1614.     curFields[whichField] . components = component;
  1615.     curFields[whichField] . nComponents = 1;
  1616.     return RegisterComponent(whichField, 0, field) ? ObjTrue : ObjFalse;
  1617. }
  1618.  
  1619. static ObjPtr RegisterByteArray(field, whichField)
  1620. ObjPtr field;
  1621. int whichField;
  1622. /*Registers an array field in field slot whichField*/
  1623. {
  1624.     Component *component = 0;
  1625.     ObjPtr var;
  1626.  
  1627.     component = (Component *) Alloc(sizeof(Component));
  1628.     if (!component)
  1629.     {
  1630.     OMErr();
  1631.     return ObjFalse;
  1632.     }
  1633.  
  1634.     component -> flags = 0;
  1635.     component -> indices = 0;
  1636.     component -> dimensions = 0;
  1637.     component -> steps = 0;
  1638.  
  1639.     curFields[whichField] . components = component;
  1640.     curFields[whichField] . nComponents = 1;
  1641.  
  1642.     return RegisterComponent(whichField, 0, field) ? ObjTrue : ObjFalse;
  1643. }
  1644.  
  1645. static ObjPtr RegisterObjectArray(field, whichField)
  1646. ObjPtr field;
  1647. int whichField;
  1648. /*Registers an object array field in field slot whichField*/
  1649. {
  1650.     int nComponents;
  1651.     int k;
  1652.     long dimension;
  1653.     Component *component = 0;
  1654.     ObjPtr retVal;
  1655.  
  1656.     if (RANK(field) != 1)
  1657.     {
  1658.     /*Only vectors allowed, bud.*/
  1659.     ReportError("RegisterObjectArray", "Only vector object arrays can be used in datasets.");
  1660.     return ObjFalse;
  1661.     }
  1662.  
  1663.     nComponents = DIMS(field)[0];
  1664.  
  1665.     component = (Component *) Alloc(nComponents * sizeof(Component));
  1666.     if (!component)
  1667.     {
  1668.     OMErr();
  1669.     return ObjFalse;
  1670.     }
  1671.  
  1672.     for (k = 0; k < nComponents; ++k)
  1673.     {
  1674.     component[k] . flags = 0;
  1675.     component[k] . indices = 0;
  1676.     component[k] . dimensions = 0;
  1677.     component[k] . steps = 0;
  1678.     }
  1679.  
  1680.     retVal = ObjTrue;
  1681.  
  1682.     curFields[whichField] . components = component;
  1683.     curFields[whichField] . nComponents = nComponents;
  1684.  
  1685.     for (dimension = 0; dimension < nComponents; ++dimension)
  1686.     {
  1687.     ObjPtr temp;
  1688.     temp = GetObjectElement(field, &dimension);
  1689.     if (!RegisterComponent(whichField, dimension, temp))
  1690.     {
  1691.         retVal = false;
  1692.     }
  1693.     }
  1694.     return retVal;
  1695. }
  1696.  
  1697. static ObjPtr RegisterByteComponent(field, whichField, whichComponent)
  1698. ObjPtr field;
  1699. int whichField, whichComponent;
  1700. /*Registers an array field in field slot whichField in component whichComponent*/
  1701. {
  1702.     Component *component;
  1703.     int *indices = 0;
  1704.     long *dimensions = 0;
  1705.     long *steps = 0;
  1706.     ObjPtr indicesVar;
  1707.     long dataSize;
  1708.     int k;
  1709.     ObjPtr var;
  1710.  
  1711.     /*A scalar array, the simplest type of field*/
  1712.     if (RANK(field))
  1713.     {
  1714.     indices = (int *) Alloc(RANK(field) * sizeof(int));
  1715.     if (!indices)
  1716.     {
  1717.         OMErr();
  1718.         return ObjFalse;
  1719.     }
  1720.     
  1721.     steps = (long *) Alloc(RANK(field) * sizeof(long));
  1722.     if (!steps)
  1723.     {
  1724.         Free(indices);
  1725.         OMErr();
  1726.         return ObjFalse;
  1727.     }
  1728.  
  1729.     dimensions = (long *) Alloc(RANK(field) * sizeof(long));
  1730.     if (!dimensions)
  1731.     {
  1732.         Free(indices);
  1733.         Free(steps);
  1734.         OMErr();
  1735.         return ObjFalse;
  1736.     }
  1737.     }
  1738.     else
  1739.     {
  1740.     steps = 0;
  1741.     indices = 0;
  1742.     dimensions = 0;
  1743.     }
  1744.  
  1745.     indicesVar = GetVar(field, INDICES);
  1746.     if (indicesVar)
  1747.     {
  1748.     if (!IsRealArray(indicesVar) || RANK(indicesVar) != 1 || DIMS(indicesVar)[0] != RANK(field))
  1749.     {
  1750.         ReportError("ReigsterRealComponent", "Bad INDICES variable");
  1751.         indicesVar = 0;
  1752.     }
  1753.     } 
  1754.  
  1755.     component = &(curFields[whichField] . components[whichComponent]);
  1756.  
  1757.     /*Fill in dimensions, indices, and steps*/
  1758.     dataSize = 1;
  1759.     for (k = RANK(field) - 1; k >= 0; --k)
  1760.     {
  1761.     if (indicesVar)
  1762.     {
  1763.         indices[k] = ((real *) ELEMENTS(indicesVar))[k];
  1764.     }
  1765.     else
  1766.     {
  1767.         indices[k] = k;
  1768.     }
  1769.     dimensions[k] = DIMS(field)[k];
  1770.     dataSize *= DIMS(field)[k];
  1771.     steps[k] =
  1772.         (k == RANK(field) - 1) ?
  1773.         1 :
  1774.         dimensions[k + 1] * steps[k + 1];
  1775.     }
  1776.  
  1777.     var = GetVar(field, CTABLE);
  1778.     if (var && IsRealArray(var) && RANK(var) == 1 && DIMS(var)[0] == 256)
  1779.     {
  1780.     Array2CArray(&(component -> cTable), var);
  1781.     }
  1782.     else
  1783.     {
  1784.     for (k = 0; k < 256; ++k)
  1785.     {
  1786.         component -> cTable[k] = (real) k;
  1787.     }
  1788.     }
  1789.  
  1790.     component -> data . comp = ELEMENTS(field);
  1791.     component -> dataCompressed = true;
  1792.     component -> dataSize = dataSize;
  1793.     component -> nIndices = RANK(field);
  1794.     component -> indices = indices;
  1795.     component -> dimensions = dimensions;
  1796.     component -> steps = steps;
  1797.     return ObjTrue;
  1798. }
  1799.  
  1800. static ObjPtr RegisterRealComponent(field, whichField, whichComponent)
  1801. ObjPtr field;
  1802. int whichField, whichComponent;
  1803. /*Registers an array field in field slot whichField in component whichComponent*/
  1804. {
  1805.     Component *component;
  1806.     int *indices = 0;
  1807.     long *dimensions = 0;
  1808.     long *steps = 0;
  1809.     ObjPtr indicesVar;
  1810.     long dataSize;
  1811.     int k;
  1812.  
  1813.     /*A scalar array, the simplest type of field*/
  1814.     if (RANK(field))
  1815.     {
  1816.     
  1817.     indices = (int *) Alloc(RANK(field) * sizeof(int));
  1818.     if (!indices)
  1819.     {
  1820.         OMErr();
  1821.         return ObjFalse;
  1822.     }
  1823.     
  1824.     steps = (long *) Alloc(RANK(field) * sizeof(long));
  1825.     if (!steps)
  1826.     {
  1827.         Free(indices);
  1828.         OMErr();
  1829.         return ObjFalse;
  1830.     }
  1831.  
  1832.     dimensions = (long *) Alloc(RANK(field) * sizeof(long));
  1833.     if (!dimensions)
  1834.     {
  1835.         Free(indices);
  1836.         Free(steps);
  1837.         OMErr();
  1838.         return ObjFalse;
  1839.     }
  1840.     }
  1841.     else
  1842.     {
  1843.     steps = 0;
  1844.     indices = 0;
  1845.     dimensions = 0;
  1846.     }
  1847.  
  1848.     indicesVar = GetVar(field, INDICES);
  1849.     if (indicesVar)
  1850.     {
  1851.     if (!IsRealArray(indicesVar) || RANK(indicesVar) != 1 || DIMS(indicesVar)[0] != RANK(field))
  1852.     {
  1853.         ReportError("ReigsterRealComponent", "Bad INDICES variable");
  1854.         indicesVar = 0;
  1855.     }
  1856.     } 
  1857.  
  1858.     component = &(curFields[whichField] . components[whichComponent]);
  1859.  
  1860.     /*Fill in dimensions, indices, and steps*/
  1861.     dataSize = 1;
  1862.     for (k = RANK(field) - 1; k >= 0; --k)
  1863.     {
  1864.     if (indicesVar)
  1865.     {
  1866.         indices[k] = ((real *) ELEMENTS(indicesVar))[k];
  1867.     }
  1868.     else
  1869.     {
  1870.         indices[k] = k;
  1871.     }
  1872.     dimensions[k] = DIMS(field)[k];
  1873.     dataSize *= DIMS(field)[k];
  1874.     steps[k] =
  1875.         (k == RANK(field) - 1) ?
  1876.         1 :
  1877.         dimensions[k + 1] * steps[k + 1];
  1878.     }
  1879.  
  1880.     component -> data . unComp = ELEMENTS(field);
  1881.     component -> dataCompressed = false;
  1882.     component -> dataSize = dataSize;
  1883.     component -> nIndices = RANK(field);
  1884.     component -> indices = indices;
  1885.     component -> dimensions = dimensions;
  1886.     component -> steps = steps;
  1887.  
  1888.     return ObjTrue;
  1889. }
  1890.  
  1891. ObjPtr GetArrayTopDim(array)
  1892. ObjPtr array;
  1893. /*Gets the topological dimension of array*/
  1894. {
  1895.     return NewInt(RANK(array));
  1896. }
  1897.  
  1898. ObjPtr GetObjArrayTopDim(array)
  1899. ObjPtr array;
  1900. /*Gets the topological dimension of array*/
  1901. {
  1902.     FuncTyp method;
  1903.     ObjPtr firstElement;
  1904.     long dimension;
  1905.  
  1906.     dimension = 0;
  1907.  
  1908.     firstElement = GetObjectElement(array, &dimension);
  1909.     method = GetMethod(firstElement, GETTOPDIM);
  1910.     if (method)
  1911.     {
  1912.     return (*method)(firstElement);
  1913.     }
  1914.     else
  1915.     {
  1916.     return NewInt(0);
  1917.     }
  1918. }
  1919.  
  1920. #ifdef PROTO
  1921. ObjPtr GetObjectElement(ObjPtr array, long *dims)
  1922. #else
  1923. ObjPtr GetObjectElement(array, dims)
  1924. ObjPtr array;
  1925. long *dims;
  1926. #endif
  1927. /*Gets a element specified by dims within array, assuming that
  1928.   array is an object array.  There had better be enough dims.*/
  1929. {
  1930.     long offset;
  1931.     int k;
  1932.     ObjPtr *elements;
  1933.  
  1934.     if (!IsObjArray(array))
  1935.     {
  1936.     return NULLOBJ;
  1937.     }
  1938.  
  1939.     offset = 0;
  1940.     for (k = 0; k < RANK(array); ++k)
  1941.     {
  1942.     if (k)
  1943.     {
  1944.         offset *= DIMS(array)[k];
  1945.     }
  1946.     offset += dims[k];
  1947.     }
  1948.     elements = (ObjPtr *) ELEMENTS(array);
  1949.  
  1950.     /*Hey, John!  Put your code in here!*/
  1951.     return elements[offset];
  1952. }
  1953.  
  1954. #ifdef PROTO
  1955. void InitArrays(void)
  1956. #else
  1957. void InitArrays()
  1958. #endif
  1959. /*Initializes the array system*/
  1960. {
  1961.     arrayClass = NewObject(NULLOBJ, sizeof(Array) - sizeof(Obj));
  1962.     ELEMENTS(arrayClass) = 0;
  1963.     DIMS(arrayClass) = 0;
  1964.     AddToReferenceList(arrayClass);
  1965.     SetMethod(arrayClass, CLEANUP, CleanupArray);
  1966.     SetMethod(arrayClass, GETTOPDIM, GetArrayTopDim);
  1967.  
  1968.     realArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
  1969.     ELEMENTS(realArrayClass) = 0;
  1970.     DIMS(realArrayClass) = 0;
  1971.     AddToReferenceList(realArrayClass);
  1972.     SetMethod(realArrayClass, REGISTERFIELD, RegisterRealArray);
  1973.     SetMethod(realArrayClass, REGISTERCOMP, RegisterRealComponent);
  1974. #ifdef SOCKETS
  1975. #if MACHINE == IRIS4D
  1976. #ifdef FASTSOCKETS
  1977. fprintf(stderr, "Using fast, raw data sockets\n");
  1978.     SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayRaw);
  1979.     SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayRaw);
  1980. #else
  1981. fprintf(stderr, "Using slow, ascii data sockets\n");
  1982.     SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayAscii);
  1983.     SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayAscii);
  1984. #endif
  1985. #else
  1986. fprintf(stderr, "Using slow, ascii data sockets\n");
  1987.     SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayAscii);
  1988.     SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayAscii);
  1989. #endif
  1990. #endif
  1991.  
  1992.     byteArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
  1993.     ELEMENTS(byteArrayClass) = 0;
  1994.     DIMS(byteArrayClass) = 0;
  1995.     AddToReferenceList(byteArrayClass);
  1996.     SetMethod(byteArrayClass, REGISTERFIELD, RegisterByteArray);
  1997.     SetMethod(byteArrayClass, REGISTERCOMP, RegisterByteComponent);
  1998.  
  1999.     pointerArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
  2000.     ELEMENTS(pointerArrayClass) = 0;
  2001.     DIMS(pointerArrayClass) = 0;
  2002.     AddToReferenceList(pointerArrayClass);
  2003.  
  2004.     shortArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
  2005.     ELEMENTS(shortArrayClass) = 0;
  2006.     DIMS(shortArrayClass) = 0;
  2007.     AddToReferenceList(shortArrayClass);
  2008.  
  2009.     objectArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
  2010.     ELEMENTS(objectArrayClass) = 0;
  2011.     DIMS(objectArrayClass) = 0;
  2012.     AddToReferenceList(objectArrayClass);
  2013.     SetMethod(objectArrayClass, MARK, MarkObjectArray);
  2014.     SetMethod(objectArrayClass, REGISTERCOMP, (FuncTyp) 0);
  2015.     SetMethod(objectArrayClass, REGISTERFIELD, RegisterObjectArray);
  2016.     SetMethod(objectArrayClass, GETTOPDIM, GetObjArrayTopDim);
  2017. #ifdef SOCKETS
  2018.     SetMethod(objectArrayClass, TRANSMITEXTRA, TransmitExtraStuffObjectArray);
  2019.     SetMethod(objectArrayClass, RECEIVEEXTRA, ReceiveExtraStuffObjectArray);
  2020. #endif
  2021. }
  2022.  
  2023. #ifdef PROTO
  2024. void KillArrays(void)
  2025. #else
  2026. void KillArrays()
  2027. #endif
  2028. /*Kills the array system*/
  2029. {
  2030.     DeleteThing(objectArrayClass);
  2031.     DeleteThing(pointerArrayClass);
  2032.     DeleteThing(byteArrayClass);
  2033.     DeleteThing(realArrayClass);
  2034.     DeleteThing(arrayClass);
  2035. }
  2036.